Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-20/nrd33.zip/NRD.PAS

Pascal/Delphi Source File | 1991-05-19 | 93KB | 3,086 lines

{$I-}
{$V-}
{$M 60000,0,655360}

{  ROUTINE:    N R D

   PURPOSE:    Control an NRD525 / NRD535 Receiver + database

   USAGE:    nrd

   AUTHOR:    Tom Whiteside 11505 Oak View, Austin, TX 78759 [phone]

   REVISION:    1.0  04-30-90  TGW  Initial Release
                1.1  07-07-90  TGW  Serial routines changed to use BIOS for
                                       Windows
                1.2  07-15-90  TGW  Efficiency tweaks to inc/dec bw/mode
                                    Cursor Highlighting for current line
                                    Cursor tracking data for inc/dec freq
                1.3  07-29-90  TGW  Remove H(ide from prompt, fix Delete
                                       leaving wrong line highlighted
                                    Added Revision to prompt
                1.4  09-03-90  TGW  Fixed inc/dec mode past boundary crashing
                                       program; asserted black backgrd on
                                       title and journal
                1.5  09-29-90  TGW  Added MAP feature

                1.6  11-18-90  TGW  Fixed 2 bugs where cursor got out of
                                    sync with "status line"
                2.0  12/01-90  TGW  Mods to support other com ports, optional
                                    MAP, help                                 easier for o
                2.1  12-02-90  TGW  Added time offset to config.dat; fixed
                                    home not putting cursor at top of screen

                2.2  12-25-90  TGW  Added "Com 0" feature to allow using prgm
                                    without serial port...
                2.3  12-27-90  TGW  Fix to eliminate hang if radio off

                2.4  03-02-91  TGW  Fix for monochrome users (in screen.pas)
                2.5  03-10-91  TGW  Added Import of Sundstrom data
                2.6  03-30-91  TGW  Added Active and Inactive log concept
                                    including write from the inactive log
                                    Added "*" command to find radio freq
                                    in database.  Fixed potential hang in
                                    comreadln.  Reduced edit field length
                                    for comments by 1 char.  (Fixed wrap bug
                                    for bottom line)  Removed dangerous Read
                                    command from Journal
                2.7  04-14-91  TGW  Fixed display bug in inc_freq
                3.0  04-26-91  TGW  Added NRD535 features
                3.1  04-27-91  TGW  Fix to journal name select; Added 535
                                    mode to auto-update receiver display
                3.2  05-12-91  TGW  Added S-meter to 535; changed mode order
                                    to AM -> ECSS_U; added graphics command
                                    for 535; misc bug fixes for 535

                3.2  05-19-91  TGW  Graphics enhancements; commands for time
                                    and spectral displays.  Performance
                                    enhancement to Spectral display
}
program nrd(input,output);

uses async, crt, dos, graph, screen, nrdio, nrdutil;

const LINES       = 25;
      CHARPERLINE = 80;
      BACKTAB     = chr(10);
      TAB         = chr(9);
      PAGEUP      = chr(3);
      PAGEDOWN    = chr(4);
      UP          = chr(15);
      DOWN        = chr(11);
      RIGHTARROW  = chr(21);
      LEFTARROW   = chr(7);
      CTRLPAGEUP  = chr(14);
      CTRLPAGEDN  = chr(16);
      HOMEKY      = chr(5);
      ENDKY       = chr(6);
      REMOTE_DLY  = 300; { msec }
      MAP_OFFSET  = 2.0; { frequency offset from center for sync det. }

var i,cnt: integer;
    ch:char;
    s:string;
    oldstat:receivertype;
    logbuf:file;
    logentry:logtype;
    min_mark,max_mark:word;
    rslt:integer;
    display_page:integer;
    update_receiver_display:boolean;
    displayed_freq:array[1..LINES] of real;
    displayed_lines:integer;
    map:boolean;
    last_log:integer;  { used for hot keying between active and last log }
    last_log_data:logtype; { used to copy data from last log to active log }
    old_time_stamp, time_stamp:word;
    enable_s_meter:boolean;
    meter_reading:integer;
    graphmode:integer;

  procedure status_window;
  begin
    window(1,25,80,25);
    gotoxy(1,1);
    writea(BLACK,BACKGROUND);
    writea(LIGHTGRAY, FOREGROUND);
    write(output,'Active Log: ');
    writea(CYAN, FOREGROUND);
    write(output,loglist.log[loglist.currentlog].logname);
    if last_log <> 0 then
      begin
        writea(LIGHTGRAY, FOREGROUND);
        write(output,'  Inactive Log: ');
        writea(CYAN, FOREGROUND);
        write(output,loglist.log[last_log].logname);
      end;
  end;

  procedure clear_log(var logdata:logtype);
  const GMTCONST = 6; { bug: must manually update with time change }

  var dy,yr,mo,dyofweek,hour,minute,sec,sec100:word;
      t:string;
  begin
    getdate(yr,mo,dy,dyofweek);
    gettime(hour,minute,sec,sec100);
    hour:=hour + gmt_offset;
    if hour >= 24 then
      begin
        hour:=hour - 24;
        dy:=dy + 1;
        if dy > 31 then { kludge date, doesn't allow for 30 day mo, etc }
          begin
            dy:=1;
            mo:=mo + 1;
            if mo > 12 then mo:=1;
          end;
      end;
    with logdata do
      begin
        {init date to today's date in yymmdd format }
        str(yr,t); delete(t,1,2);
        date:=t;
        str(mo,t);
        if length(t) < 2 then t:=concat('0',t);
        date:=concat(date,t);
        str(dy,t);
        if length(t) < 2 then t:=concat('0',t);
        date:=concat(date,t);

        { init time in gmt }

        str(hour,t);
        while length(t) < 2 do t:=concat('0',t);
        begin_time:=t;
        str(minute,t);
        while length(t) < 2 do t:=concat('0',t);
        begin_time:=concat(begin_time,t);
        end_time:=begin_time;
        frequency:= receiverstat.frequency;
        callsign:=  '';
        location:=  '';
        comment:=   '';
        mode:=      receiverstat.mode;
        bandwidth:= receiverstat.bandwidth;
        agc:=       receiverstat.agc;
        attenuator:=receiverstat.attenuator;
      end;
  end;

  procedure draw_display_titles;
  begin
    top_window;
    gotoxy(1,5);
    clreol;
    case display_page of
      1: begin
           gotoxy(2,5);
           write(output,'Num');
           gotoxy(7,5);
           write(output,'Date');
           gotoxy(13,5);
           write(output,'Strt');
           gotoxy(18,5);
           write(output,'End');
           gotoxy(24,5);
           write(output,'Freq');
           gotoxy(32,5);
           write(output,'Station ID');
           gotoxy(52,5);
           write(output,'Location');
         end;
      2: begin
           gotoxy(3,5);
           write(output,'Freq');
           gotoxy(11,5);
           write(output,'Comment');
         end;
      3: begin
           gotoxy(2,5);
           write(output,'Num');
           gotoxy(7,5);
           write(output,'Date');
           gotoxy(13,5);
           write(output,'Strt');
           gotoxy(18,5);
           write(output,'End');
           gotoxy(24,5);
           write(output,'Freq');
           gotoxy(32,5);
           write(output,'Mode');
           gotoxy(39,5);
           write(output,'BW');
           gotoxy(43,5);
           write(output,'AGC');
           gotoxy(48,5);
           write(output,'Attn');
         end;
    end;
  end;

  procedure init_rec_window;

    procedure draw_box(width,hieght:integer);
    const TL = chr(201);
          TR = chr(187);
          BL = chr(200);
          BR = chr(188);
          HZ = chr(205);
          VT = chr(186);

    var i:integer;

      procedure draw_horiz;
      var i:integer;
      begin
        for i:=1 to width - 2 do write(output,HZ);
      end;

    begin
      { draw top }
      gotoxy(1,2);
      write(output,TL);
      draw_horiz;
      write(output,TR);

      { draw sides }
      for i:=1 to hieght - 2 do
        begin
          gotoxy(1,i + 2);      write(output,VT);
          gotoxy(width, i + 2); write(output,VT);
        end;

      { draw bottom }
      gotoxy(1,hieght + 1);
      write(output,BL);
      draw_horiz;
      write(output,BR);
    end;

  begin
    top_window;
    writea(BLACK,BACKGROUND);
    home;
    cmd_prompt(prompt_num);
    writea(BROWN,FOREGROUND);
    draw_box(REC_WIN_X_BOTTOM - REC_WIN_X_TOP + 1,
             REC_WIN_Y_BOTTOM - REC_WIN_Y_TOP - 1) ;
    gotoxy(30,2);
    writea(LIGHTGRAY,FOREGROUND);
    if radio_type = 525
       then write(output,'NRD 525 Status')
       else write(output,'NRD 535 Status');
    gotoxy(3,3);
    write(output,'Mode:');
    gotoxy(15,3);
    write(output,'BW:');
    gotoxy(29,3);
    write(output,'AGC:');
    if radio_type = 525 then
      begin
        gotoxy(42,3);
        write(output,'Ch:');
      end;
    gotoxy(54,3);
    write(output,'Freq:');
    gotoxy(68,3);
    write(output,' khz');
    display_page:=1;
    writea(LIGHTGRAY,FOREGROUND);
    draw_display_titles;
    writea(LIGHTGRAY,FOREGROUND);
  end;

  procedure show_receiver;
  var s:string;

    procedure do_out(unchanged:boolean; s:string);
    begin
      if not unchanged then writea(RED,FOREGROUND);
      write(output,s);
      writea(CYAN,FOREGROUND);
    end;

  begin
     x_pos:=wherex; y_pos:=wherey;
    top_window;
    writea(CYAN,FOREGROUND);
    with receiverstat do
      begin
        gotoxy(9,3);
        case mode of
          RTTY:     s:='RTTY ';
          CW:       s:='CW   ';
          USB:      s:='USB  ';
          LSB:      s:='LSB  ';
          AM:       s:='AM   ';
          FM:       s:='FM   ';
          FAX:      s:='FAX  ';
          ECSS_USB: s:='ECSSu';
          ECSS_LSB: s:='ECSSl';
        end;
        do_out(receiverstat.mode = oldstat.mode,s);
        gotoxy(19,3);
        case bandwidth of
          WIDE: s:='WIDE ';
          INTER:s:='INTER';
          NARR: s:='NARR ';
          AUX:  s:='AUX  ';
         end;
        do_out(receiverstat.bandwidth = oldstat.bandwidth,s);
         gotoxy(34,3);
         case agc of
           SLOW: s:='SLOW';
           FAST: s:='FAST';
           OFF:  s:='OFF ';
         end;
         do_out(receiverstat.agc = oldstat.agc,s);
         case attenuator of
           YES:  s:='ATT';
           NO:   s:='   ';
         end;
         gotoxy(74,3);
         do_out(receiverstat.attenuator = oldstat.attenuator,s);
         if radio_type = 525 then
           begin
             gotoxy(46,3);
             str(channel:3,s);
             do_out(receiverstat.channel = oldstat.channel,s);
           end;
         gotoxy(60,3);
         str(frequency:8:2,s);
         do_out(receiverstat.frequency = oldstat.frequency,s);
         gotoxy(78,3);
         if map then write(output,'K') else write(output,' ');
         writea(LIGHTGRAY,FOREGROUND);
      end;
    bottom_window;
    oldstat:=receiverstat;
    gotoxy(x_pos,y_pos);
  end;


  procedure program_radio(log_entry:logtype);

  { set receiver to log entry; side effect - zaps channel 199 on 535 }

  begin
    remote_on;
    if radio_type = 535 then
        with log_entry do
          set_all(199,attenuator,bandwidth,mode,frequency,agc)
    else
      begin
        if map then {force to AM}
          begin
            set_freq(log_entry.frequency + MAP_OFFSET);
            set_mode(AM);
            set_bandwidth(WIDE);
            set_agc(FAST);
          end
        else {use log entry}
          begin
            set_freq(log_entry.frequency);
            if (radio_type = 525) and (log_entry.mode in [ECSS_USB,ECSS_LSB])
               then log_entry.mode:=AM;
            set_mode(log_entry.mode);
            set_bandwidth(log_entry.bandwidth);
            set_agc(log_entry.agc);
          end;
        set_attenuator(log_entry.attenuator);
      end;
    remote_off(REMOTE_DLY);
    update_receiver_display:=TRUE;
  end;

  function mode_to_str(mode:modetype):short_str;
  var s:short_str;
  begin
    case mode of
      RTTY:     s:='RTTY';
      CW:       s:=' CW';
      USB:      s:='USB';
      LSB:      s:='LSB';
      AM:       s:=' AM';
      FM:       s:=' FM';
      FAX:      s:='FAX';
      ECSS_USB: s:='ECSSu';
      ECSS_LSB: s:='ECSSl';
    end;
    mode_to_str:=s;
  end;

  function bandwidth_to_str(bandwidth:bandwidthtype):short_str;
  var s:short_str;
  begin
    case bandwidth of
      NARR:  s:=' NARR';
      INTER: s:='INTER';
      WIDE:  s:=' WIDE';
      AUX:   s:=' AUX';
    end;
    bandwidth_to_str:=s;
  end;

  procedure show_log_line(logdata:logtype;rec,i:word);

    procedure show_line1;
    begin
      write(output,rec:4);
      with logdata do
        begin
          gotoxy(6,i);
          write(output,date);
          gotoxy(13,i);
          write(output,begin_time);
          gotoxy(18,i);
          write(output,end_time);
          gotoxy(23,i);
          write(output,frequency:8:2);
          gotoxy(32,i);
          write(output,callsign);
          gotoxy(52,i);
          write(output,location);
        end;
    end;

    procedure show_line2;
    begin
      with logdata do
        begin
          gotoxy(2,i);
          write(output,frequency:8:2);
          gotoxy(11,i);
          write(output,comment);
        end;
    end;

    procedure show_line3;
    var s:short_str;
    begin
      write(output,rec:4);
      with logdata do
        begin
          gotoxy(6,i);
          write(output,date);
          gotoxy(13,i);
          write(output,begin_time);
          gotoxy(18,i);
          write(output,end_time);
          gotoxy(23,i);
          write(output,frequency:8:2);
          gotoxy(32,i);
          s:=mode_to_str(mode);
          write(output,s);
          gotoxy(37,i);
          s:=bandwidth_to_str(bandwidth);
          write(output,s);
          gotoxy(43,i);
          case agc of
            FAST: write(output,'FAST');
            SLOW: write(output,'SLOW');
            OFF:  write(output,' OFF');
          end;
          gotoxy(49,i);
          case attenuator of
            YES: write(output,'ON');
            NO:  write(output,'OFF');
          end;
        end;
    end;

  begin
    gotoxy(1,i); clreol;
    case display_page of
      1: show_line1;
      2: show_line2;
      3: show_line3;
    end;
  end;

  function precess(var rec:integer; cnt:integer):boolean;
  { skip cnt displayed records; return TRUE is not past eof }
  var i:integer;
  begin
    for i:=1 to cnt do
      begin
        rec:=rec + 1;
        while (rec < records)
          and (recdata.recstat[recdata.recptr[rec]] <> SHOW) do
            rec:=rec + 1;
      end;
    if rec > records then rec:=records;
    precess:=recdata.recstat[recdata.recptr[rec]] = SHOW;
  end;

  procedure sync_loglist;
  var dummy:boolean;
      i,y_pos:integer;
      recnum:integer;
  begin
    y_pos:=wherey;
    i:=loglist.currentlog;
    loglist.log[i].records:=records;
    recnum:=rec - 1;
    dummy:=precess(recnum,y_pos);
    loglist.log[i].rec:=recnum;
    put_loglist(loglist);
  end;

  procedure show_log(rec:integer; refresh_screen,highlight:boolean);
  { refresh_screen = TRUE; paint entire screen with log entries
                   = FALSE then highlight line if indicated }
  var i,j,x_temp,y_temp:integer;
      logdata:logtype;
  begin
    writea(CYAN,FOREGROUND); writea(BLACK,BACKGROUND);
    i:=0; j:=rec - 1;
    y_temp:=wherey; { used to highlight cursor line }
    x_temp:=wherex;
    if refresh_screen then home;
    while (i < LINES - REC_WIN_Y_BOTTOM - 1) and (j < records) do
      begin
        inc(i);
        if precess(j,1) then
          begin
            get_log(logbuf,logdata,recdata.recptr[j]);
            displayed_freq[i]:=logdata.frequency;
            if (j >= min_mark) and (j <= max_mark) then
              begin
                writea(BLACK,FOREGROUND);
                writea(YELLOW,BACKGROUND);
                show_log_line(logdata,j,i);
                writea(BLACK,BACKGROUND);
                writea(CYAN,FOREGROUND);
              end
            else if (i = y_temp) and highlight then
              begin
                writea(BLACK,FOREGROUND);
                writea(CYAN,BACKGROUND);
                show_log_line(logdata,j,i);
                writea(BLACK,BACKGROUND);
                writea(CYAN,FOREGROUND);
              end
            else if refresh_screen or ((i = y_temp) and not highlight)
              then show_log_line(logdata,j,i);
          end;
      end;
    displayed_lines:=i;
    gotoxy(x_temp,y_temp);
  end;

  procedure do_mark;
  var recnum:integer;
      dummy:boolean;

  begin
    x_pos:=wherex; y_pos:=wherey;
    recnum:=rec - 1;
    dummy:=precess(recnum,y_pos);
    if recnum < min_mark then min_mark:=recnum;
    if recnum > max_mark then max_mark:=recnum;
    show_log(rec,TRUE,TRUE);
  end;

  procedure do_unmark(display:boolean);
  begin
    x_pos:=wherex; y_pos:=wherey;
    max_mark:=0;
    min_mark:=MAXREC + 1;
    if display then show_log(rec,TRUE,TRUE);
  end;

  procedure do_undelete;
  var t,recnum:integer;
      x_pos,y_pos:integer;
      dummy:boolean;
      i,j:integer;
      ch:char;
  begin
    write_prompt('uNdelete:  Type "y" to continue');
    ch:=upcase(fetch);
    cmd_prompt(prompt_num);
    bottom_window;
    if ch <> 'Y' then exit;
    x_pos:=wherex; y_pos:=wherey;
    recnum:=rec - 1;
    dummy:=precess(recnum,y_pos);
    i:=records;

    while (i > 1) and (recdata.recstat[recdata.recptr[i]] <> DELETED)
      do i:=i - 1;
    if recdata.recstat[recdata.recptr[i]] = DELETED then { found one }
      begin
        t:=recdata.recptr[i];
        recdata.recstat[t]:=SHOW;
        for j:=i downto recnum + 1 do
          recdata.recptr[j]:=recdata.recptr[j - 1];
        recdata.recptr[recnum]:=t;
        put_recdata(loglist.currentlog,recdata);
        show_log(rec,TRUE,TRUE);
      end;
  end;

  procedure do_sort(auto:boolean);
  var sortdata:sort_array_type;
      subsortdata:sort_array_type;
      primary,secondary:char;

    function get_sort_type(auto:boolean; var primary, secondary:char):boolean;
    begin
      if auto then { automatically do Frequency, Time sort }
        begin
          get_sort_type:=TRUE;
          primary:='F';
          secondary:='T';
          exit;
        end;
      repeat
        write_prompt('Sort - Primary field: D(ate, T(ime, F(req, C(all,'
                     +' L(oc, M(ode, Q(uit');
        primary:=upcase(fetch);
      until primary in ['D','T','F','C','L','M','Q'];
      if primary <> 'Q' then
        repeat
          write_prompt('Sort - Secondary field: D(ate, T(ime, F(req, C(all,'
                     +' L(oc, M(ode, Q(uit');
          secondary:=upcase(fetch);
        until secondary in ['D','T','F','C','L','M','Q'];
      cmd_prompt(prompt_num);
      bottom_window;
      get_sort_type:=(primary <> 'Q') and (secondary <> 'Q');
    end;

    procedure get_fields;
    var i:integer;
        logdata:logtype;

      procedure init_array(var sortdata:short_str; cmd:char);
      begin
        case cmd of
          'D':sortdata:=copy(logdata.date,1,SHORTSTRLEN);
          'T':sortdata:=copy(logdata.begin_time,1,SHORTSTRLEN);
          'F':str(logdata.frequency:8:1,sortdata);
          'C':sortdata:=copy(logdata.callsign,1,SHORTSTRLEN);
          'L':sortdata:=copy(logdata.location,1,SHORTSTRLEN);
          'M':case logdata.mode of
                RTTY:sortdata:='RTTY';
                CW  :sortdata:='CW';
                USB :sortdata:='USB';
                LSB :sortdata:='LSB';
                AM  :sortdata:='AM';
                FM  :sortdata:='FM';
                FAX :sortdata:='FAX';
               end;
        end;
      end;

    begin
      home;
      for i:=1 to records do
      begin
        if recdata.recstat[i] = DELETED then { dummy sort pos }
          begin
            sortdata[i]:=chr(255);
            subsortdata[i]:=chr(255);
          end
        else
          begin
            get_log(logbuf,logdata,i);
            init_array(sortdata[i],primary);
            init_array(subsortdata[i],secondary);
          end;
        recdata.recptr[i]:=i;
      end;
    end;

    procedure primary_sort; { sort on primary field }
    begin
      write(output,'Primary sort');
      sort(sortdata,recdata.recptr,1,records);
    end;

    procedure secondary_sort; { sort on secondary field }
    var i,top:integer;
        tempstr:string;
    begin
      top:=1; home;
      write(output,'Secondary sort');
      while (top < records) do
        begin
          i:=0;
          tempstr:=sortdata[top];
          while (top + i < records) and (tempstr = sortdata[top + i]) do
            begin
              sortdata[top + i]:=subsortdata[recdata.recptr[top + i]];
              inc(i);
            end;
          sort(sortdata,recdata.recptr,top,i);
          top:=top + i;
        end;
    end;

  begin
    if get_sort_type(auto,primary,secondary) then
      begin
        get_fields;
        primary_sort;
        secondary_sort;
      end;
    show_log(rec,TRUE,TRUE);
    put_recdata(loglist.currentlog,recdata);
  end;

  function upcasestr(s:string):string;
  var i:integer;
      s1:string;
  begin
    s1:=s;
    for i:=1 to length(s) do s1[i]:=upcase(s[i]);
    upcasestr:=s1;
  end;

  procedure do_page;
  begin
    x_pos:=wherex; y_pos:=wherey;
    display_page:=display_page + 1;
    if display_page > 3 then display_page:=1;
    draw_display_titles;
    bottom_window;
    if rslt = 0 then show_log(rec,TRUE,TRUE);
  end;

  procedure do_tab;
  begin
    x_pos:=wherex; y_pos:=wherey;
    case display_page of
      1:begin
          if x_pos in [1..5]   then x_pos:=6  else
          if x_pos in [6..12]  then x_pos:=13 else
          if x_pos in [13..17] then x_pos:=18 else
          if x_pos in [18..22] then x_pos:=23 else
          if x_pos in [23..31] then x_pos:=32 else
          if x_pos in [32..51] then x_pos:=52 else
            begin
              x_pos:=11;
              gotoxy(x_pos,y_pos);
              do_page;
            end;
          gotoxy(x_pos,y_pos);
        end;
      2:begin
          x_pos:=32;
          gotoxy(x_pos,y_pos);
          do_page;
        end;
      3:begin
          if x_pos in [1..5]   then x_pos:=6  else
          if x_pos in [6..12]  then x_pos:=13 else
          if x_pos in [13..17] then x_pos:=18 else
          if x_pos in [18..22] then x_pos:=23 else
          if x_pos in [23..31] then x_pos:=32 else
          if x_pos in [32..36] then x_pos:=37 else
          if x_pos in [37..42] then x_pos:=43 else
          if x_pos in [43..48] then x_pos:=49 else
            begin
              x_pos:=6;
              gotoxy(x_pos,y_pos);
              do_page;
            end;
          gotoxy(x_pos,y_pos);
        end;
    end;
  end;

  procedure do_backtab;
  begin
    x_pos:=wherex; y_pos:=wherey;
    case display_page of
      1:begin
          if x_pos in [7..13]  then x_pos:=6  else
          if x_pos in [14..18] then x_pos:=13 else
          if x_pos in [19..23] then x_pos:=18 else
          if x_pos in [24..32] then x_pos:=23 else
          if x_pos in [33..80] then x_pos:=32 else
            begin
              x_pos:=38;
              gotoxy(x_pos,y_pos);
              display_page:=display_page - 2;
              do_page;
            end;
          gotoxy(x_pos,y_pos);
        end;
      2:begin
          if x_pos in [3..10]  then x_pos:=2  else
          if x_pos in [12..80] then x_pos:=11 else
            begin
              x_pos:=52;
              gotoxy(x_pos,y_pos);
              display_page:=display_page - 2;
              do_page;
            end;
          gotoxy(x_pos,y_pos);
        end;
      3:begin
          if x_pos in [7..13]  then x_pos:=6  else
          if x_pos in [14..18] then x_pos:=13 else
          if x_pos in [19..23] then x_pos:=18 else
          if x_pos in [24..32] then x_pos:=23 else
          if x_pos in [33..37] then x_pos:=32 else
          if x_pos in [38..43] then x_pos:=37 else
          if x_pos in [44..49] then x_pos:=43 else
          if x_pos in [50..80] then x_pos:=49 else
            begin
              x_pos:=11;
              gotoxy(x_pos,y_pos);
              display_page:=display_page - 2;
              do_page;
            end;
          gotoxy(x_pos,y_pos);
        end;
    end;
  end;

  procedure do_edit; { edit field cursor is on }
  var recnum:integer;
      logdata:logtype;
      s:string;
      i,j,y,dummy:integer;
      tabkey,backtabkey:boolean;

    procedure edit_page1;
    begin
      case x_pos of
         6..12: editfield(5, y,DATELEN,FALSE,tabkey,backtabkey,logdata.date);
        13..17: begin
                  editfield(12,y,TIMELEN,FALSE,tabkey,backtabkey
                                ,logdata.begin_time);
                  while length(logdata.begin_time) < 4 do
                      logdata.begin_time:=concat('0',logdata.begin_time);
                end;
        18..22: begin
                  editfield(17,y,TIMELEN,FALSE,tabkey,backtabkey
                                ,logdata.end_time);
                  while length(logdata.end_time) < 4 do
                      logdata.end_time:=concat('0',logdata.end_time);
                end;
        23..31: begin
                  str(logdata.frequency:8:2,s);
                  editfield(22,y,8,TRUE,tabkey,backtabkey,s);
                  val(s,logdata.frequency,dummy);
                end;
        32..51: editfield(31,y,CALLSIGNLEN,FALSE,tabkey,backtabkey
                              ,logdata.callsign);
        52..80: editfield(51,y,LOCATIONLEN,FALSE,tabkey,backtabkey
                              ,logdata.location);
      end;
    end;

    procedure edit_page2;
    begin
      case x_pos of
         1..10: begin
                  str(logdata.frequency:8:2,s);
                  editfield(1,y,8,TRUE,tabkey,backtabkey,s);
                  val(s,logdata.frequency,dummy);
                end;
        11..80: editfield(10,y,COMMENTLEN-1,FALSE,tabkey,backtabkey
                              ,logdata.comment);
      end;
    end;

    procedure edit_page3;
    begin
      case x_pos of
         6..12: editfield(5, y,DATELEN,FALSE,tabkey,backtabkey,logdata.date);
        13..17: begin
                  editfield(12,y,TIMELEN,FALSE,tabkey,backtabkey
                                ,logdata.begin_time);
                  while length(logdata.begin_time) < 4 do
                      logdata.begin_time:=concat('0',logdata.begin_time);
                end;
        18..22: begin
                  editfield(17,y,TIMELEN,FALSE,tabkey,backtabkey
                                ,logdata.end_time);
                  while length(logdata.end_time) < 4 do
                      logdata.end_time:=concat('0',logdata.end_time);
                end;
        23..31: begin
                  str(logdata.frequency:8:2,s);
                  editfield(22,y,8,TRUE,tabkey,backtabkey,s);
                  val(s,logdata.frequency,dummy);
                end;
        32..36: begin
                  case logdata.mode of
                    RTTY: s:='RTTY';
                    CW:   s:=' CW';
                    USB:  s:='USB';
                    LSB:  s:='LSB';
                    AM:   s:=' AM';
                    FM:   s:=' FM';
                    FAX:  s:='FAX';
                  end;
                  editfield(31,y,4,FALSE,tabkey,backtabkey,s);
                  s:=upcasestr(s);
                  if pos('RTTY',s) > 0 then logdata.mode:=RTTY else
                  if pos('CW',s)   > 0 then logdata.mode:=CW   else
                  if pos('USB',s)  > 0 then logdata.mode:=USB  else
                  if pos('LSB',s)  > 0 then logdata.mode:=LSB  else
                  if pos('AM',s)   > 0 then logdata.mode:=AM   else
                  if pos('FM',s)   > 0 then logdata.mode:=FM   else
                  if pos('FAX',s)  > 0 then logdata.mode:=FAX
                end;
        37..42: begin
                  case logdata.bandwidth of
                    NARR: s:=' NARR';
                    INTER:s:='INTER';
                    WIDE: s:=' WIDE';
                    AUX:  s:=' AUX';
                  end;
                  editfield(36,y,5,FALSE,tabkey,backtabkey,s);
                  s:=upcasestr(s);
                  if pos('INTER',s) > 0 then logdata.bandwidth:=INTER else
                  if pos('NARR',s)  > 0 then logdata.bandwidth:=NARR  else
                  if pos('WIDE',s)  > 0 then logdata.bandwidth:=WIDE  else
                  if pos('AUX' ,s)  > 0 then logdata.bandwidth:=AUX
                end;
        43..48: begin
                  case logdata.agc of
                    FAST: s:='FAST';
                    SLOW: s:='SLOW';
                    OFF:  s:=' OFF';
                  end;
                  editfield(42,y,4,FALSE,tabkey,backtabkey,s);
                  s:=upcasestr(s);
                  if pos('FAST',s) > 0 then logdata.agc:=FAST else
                  if pos('SLOW',s) > 0 then logdata.agc:=SLOW else
                  if pos('OFF',s)  > 0 then logdata.agc:=OFF
                end;
        49..51: begin
                  case logdata.attenuator of
                    YES: s:='ON';
                    NO:  s:='OFF';
                  end;
                  editfield(48,y,3,FALSE,tabkey,backtabkey,s);
                  s:=upcasestr(s);
                  if pos('OFF',s) > 0 then logdata.attenuator:=NO else
                  if pos('ON',s)  > 0 then logdata.attenuator:=YES
                end;
      end;
    end;

  begin { do_edit }
    x_pos:=wherex; y_pos:=wherey; y:=y_pos - 1;
    recnum:=rec - 1;
    if precess(recnum,y_pos) then
      begin
        get_log(logbuf,logdata,recdata.recptr[recnum]);
        case display_page of
          1: edit_page1;
          2: edit_page2;
          3: edit_page3;
        end;
        put_log(logbuf,logdata,recdata.recptr[recnum]);
        if not (tabkey or backtabkey) then
          begin
            gotoxy(x_pos,y_pos);
            show_log(rec,TRUE,TRUE);
          end;
      end;
    gotoxy(x_pos,y_pos);
    if tabkey then
      begin
        do_tab;
        do_edit;
      end
    else if backtabkey then
      begin
        do_backtab;
        do_edit;
      end;
  end;

  procedure do_delete;
  var x_pos,y_pos:integer;
      recnum:integer;
      ch:char;
      i,t:integer;
  begin
    x_pos:=wherex; y_pos:=wherey;
    recnum:=rec - 1;
    write_prompt('Delete:  Type "y" to continue');
    ch:=upcase(fetch);
    cmd_prompt(prompt_num);
    bottom_window;
    if ch = 'Y' then if precess(recnum,y_pos) then
      begin
        t:=recdata.recptr[recnum];
        recdata.recstat[t]:=DELETED;
        for i:=recnum to records - 1 do with recdata do
          recptr[i]:=recptr[i + 1];
        recdata.recptr[records]:=t;
        show_log(rec,TRUE,TRUE);
        put_recdata(loglist.currentlog,recdata);
      end;
  end;

  procedure do_log;
  var x_pos,y_pos:integer;
      t,recnum:integer;
      ch:char;
      i,j:integer;
      dummy:boolean;
      logdata:logtype;
  begin
    x_pos:=32; y_pos:=wherey;
    recnum:=rec - 1;
    dummy:=precess(recnum,y_pos);
    { get receiver status }
    if radio_type = 525 then remote_on else toggle_remote;
    show_receiver;
    remote_off(0);
    i:=1;
    while (i < records) and (recdata.recstat[recdata.recptr[i]] <> DELETED)
       do inc(i);
    if (i >= records) and (recdata.recstat[recdata.recptr[i]]<>DELETED) then
      { insert new entry here }
      begin
        inc(records);
        i:=records;
        recdata.recptr[i]:=i;
        loglist.log[loglist.currentlog].records:=records;
        put_loglist(loglist);
      end;
    t:=recdata.recptr[i];
    if recnum = 0 then recnum:=1; { special case for new arrays }
    for j:=i downto recnum + 1 do with recdata do
      recptr[j]:=recptr[j - 1];
    recdata.recptr[recnum]:=t;
    recdata.recstat[t]:=SHOW;
    clear_log(logdata);
    with receiverstat do
      begin
        if map then {center frequency}
          begin
            logdata.frequency:=trunc(frequency/5.0 + 0.5) * 5;
            logdata.mode:=USB;
            logdata.bandwidth:=INTER;
          end
        else
          begin
            logdata.frequency:=frequency;
            logdata.mode:=mode;
            logdata.bandwidth:=bandwidth;
          end;
        logdata.agc:=agc;
        logdata.attenuator:=attenuator;
      end;
    put_log(logbuf,logdata,recdata.recptr[recnum]);
    put_recdata(loglist.currentlog,recdata);
    if display_page <> 1 then
      begin
        display_page:=1;
        draw_display_titles;
        bottom_window;
      end;
    gotoxy(x_pos,y_pos);
    show_log(rec,TRUE,TRUE);
    do_edit;
  end;

  procedure do_tune;

  { assign log entry at cursor location to radio }

  var recnum:integer;
      logdata:logtype;
  begin
   y_pos:=wherey;
   recnum:=rec - 1;
   if precess(recnum, y_pos) then
     begin
       get_log(logbuf,logdata,recdata.recptr[recnum]);
       program_radio(logdata);
       if radio_type = 535 then toggle_remote;
     end;
  end;

  function find_rec(rec:integer; freq:real):integer; { find record >= frequency }
  var j:integer;
      logdata:logtype;
      first_try, found:boolean;
  begin
    j:=rec - 20; { skip back enuf records to find start hopefully }
    if j < 0 then j:=0;
    found:=FALSE; first_try:=TRUE;
    while (j < records) and not found do
      begin
        if precess(j,1) then
          begin
            get_log(logbuf,logdata,recdata.recptr[j]);
            if first_try and (logdata.frequency > freq)
              then j:=0
              else found:=logdata.frequency >= freq;
            first_try:=FALSE;
          end;
      end;
    find_rec:=j;
  end;

  procedure inc_freq;
  var s:string;
      x_pos,y_pos,i:integer;
      orig_freq:real;

    procedure display(frequency:real); { find displayed line matching freq }
    var found,lt:boolean;
        j:integer;
    begin
      j:=0; found:=FALSE; lt:=FALSE;
      while (j < LINES - REC_WIN_Y_BOTTOM - 1) and not found do
        begin
          inc(j);
          if frequency > displayed_freq[j] then lt:=TRUE; {condition for fnd}
          found:=frequency <= displayed_freq[j];
        end;
      if found and lt then { found it and its on the screen }
        begin
          y_pos:=j;
          gotoxy(x_pos,y_pos);
          show_log(rec,FALSE,TRUE);
        end
      else { new screen }
        begin
          rec:=find_rec(rec, frequency);
          gotoxy(x_pos,1);
          show_log(rec,TRUE,TRUE);
        end;
    end;

  begin {inc_freq}
    x_pos:=wherex; y_pos:=wherey;
    show_log(rec,FALSE,FALSE); { unhighlight current cursor line }
    with receiverstat do
      begin
        remote_on;
        orig_freq:=frequency;
        frequency:=trunc(frequency/10.0) * 10.0;
        if orig_freq - frequency >= 5.0 then frequency:=frequency + 5.0;
        case mode of
          USB: set_freq(frequency + 4.0);
          LSB: set_freq(frequency + 6.0);
          AM:
          else
            begin
              for i:=1 to 4 do
                begin
                  set_freq(frequency + i);
                  delay(150);
                end;
            end;
        end;
        delay(200);
        frequency:=frequency + 5.0;
        if map then frequency:=frequency + MAP_OFFSET;
        set_freq(frequency);
        remote_off(0);
        if radio_type = 535 then toggle_remote;
        show_receiver;
        display(frequency);
      end;
  end;

  procedure dec_freq;
  var s:string;
      x_pos,y_pos,i:integer;
      orig_freq:real;

    procedure display(frequency:real); { find displayed line matching freq }
    var found,lt:boolean;
        j:integer;
    begin
      j:=LINES - REC_WIN_Y_BOTTOM; found:=FALSE; lt:=FALSE;
      while (j > 1) and not found do
        begin
          dec(j);
          if frequency < displayed_freq[j] then lt:=TRUE;{condition for fnd}
          found:=frequency >= displayed_freq[j];
        end;
      if found and lt then { found it and its on the screen }
        begin
          gotoxy(x_pos,j);
          show_log(rec,FALSE,TRUE);
        end
      else { new screen }
        begin
          rec:=find_rec(rec, frequency);
          rec:=rec - LINES + REC_WIN_Y_BOTTOM + 2;
          if rec < 1 then rec:=1;
          gotoxy(x_pos,1);
          show_log(rec,TRUE,TRUE);
          show_log(rec,FALSE,FALSE);
          y_pos:=0; found:=FALSE;
          while not found and (y_pos < LINES - REC_WIN_Y_BOTTOM - 1) do
            begin
              inc(y_pos);
              found:=displayed_freq[y_pos] >=frequency;
            end;
          gotoxy(x_pos,y_pos);
          show_log(rec,FALSE,TRUE);
        end;
    end;

  begin {dec_freq}
    x_pos:=wherex; y_pos:=wherey;
    show_log(rec,FALSE,FALSE); { unhighlight current cursor line }
    with receiverstat do
      begin
        remote_on;
        orig_freq:=frequency;
        frequency:=trunc(frequency/10.0) * 10.0;
        if orig_freq - frequency > 5.0 then frequency:=frequency + 10.0
        else if orig_freq - frequency > 0.0 then frequency:=frequency + 5.0;
        case mode of
          USB: set_freq(frequency - 6.0);
          LSB: set_freq(frequency - 4.0);
          AM:
          else
            begin
              for i:=1 to 4 do
                begin
                  set_freq(frequency - i);
                  delay(150);
                end;
            end;
        end;
        delay(200);
        frequency:=frequency - 5.0;
        if map then frequency:= frequency + MAP_OFFSET;
        set_freq(frequency);
        remote_off(0);
        if radio_type = 535 then toggle_remote;
        show_receiver;
        display(receiverstat.frequency);
      end;
  end;

  procedure find_freq;
  var s:string;
      x_pos,y_pos,i:integer;
      orig_freq:real;
      ch:char;

    procedure display(frequency:real); { find displayed line matching freq }
    var found:boolean;
    begin
      rec:=find_rec(1, frequency);
      rec:=rec - LINES + REC_WIN_Y_BOTTOM + 2;
      if rec < 1 then rec:=1;
      gotoxy(x_pos,1);
      show_log(rec,TRUE,TRUE);
      show_log(rec,FALSE,FALSE);
      y_pos:=0; found:=FALSE;
      while not found and (y_pos < LINES - REC_WIN_Y_BOTTOM - 1) do
        begin
          inc(y_pos);
          found:=displayed_freq[y_pos] >=frequency;
        end;
      gotoxy(x_pos,y_pos);
      show_log(rec,FALSE,TRUE);
    end;

  begin {find_freq}
    x_pos:=wherex; y_pos:=wherey;
    show_log(rec,FALSE,FALSE); { unhighlight current cursor line }
    with receiverstat do
      begin
        if radio_type = 525 then remote_on
        else toggle_remote;
        remote_off(0);
        show_receiver;
        display(receiverstat.frequency);
      end;
  end;

  procedure inc_mode;
  var x_pos,y_pos:integer;
  begin
    x_pos:=wherex; y_pos:=wherey;
    with receiverstat do
      begin
        remote_on;
        if radio_type = 525 then
          begin
            if mode < FAX
              then mode:=succ(mode)
              else mode:=RTTY;
          end
        else { do special case for nrd535 }
          begin
            case mode of
                  RTTY: mode:=CW;
                    CW: mode:=USB;
                   USB: mode:=LSB;
                   LSB: mode:=AM;
                    AM: mode:=ECSS_USB; { change order }
              ECSS_USB: mode:=ECSS_LSB;
              ECSS_LSB: mode:=FM;
                    FM: mode:=FAX;
                   FAX: mode:=RTTY;
            end;
          end;
        set_mode(mode);
        remote_off(REMOTE_DLY + 100);
        if radio_type = 535 then toggle_remote;
        show_receiver;
        gotoxy(x_pos,y_pos);
      end;
  end;

  procedure dec_mode;
  var x_pos,y_pos:integer;
  begin
    x_pos:=wherex; y_pos:=wherey;
    with receiverstat do
      begin
        remote_on;
        if radio_type = 525 then
          begin
            if mode > RTTY
              then mode:=pred(mode)
              else mode:=FAX;
          end
        else { do special case for nrd535 }
          begin
            case mode of
                  RTTY: mode:=FAX;
                    CW: mode:=RTTY;
                   USB: mode:=CW;
                   LSB: mode:=USB;
                    AM: mode:=LSB;
              ECSS_USB: mode:=AM;
              ECSS_LSB: mode:=ECSS_USB;
                    FM: mode:=ECSS_LSB;
                   FAX: mode:=FM;
            end;
          end;
        set_mode(mode);
        remote_off(REMOTE_DLY + 100);
        if radio_type = 535 then toggle_remote;
        show_receiver;
        gotoxy(x_pos,y_pos);
      end;
  end;

  procedure inc_bandwidth;
  begin
    with receiverstat do
      begin
        remote_on;
        bandwidth:=succ(bandwidth);
        set_bandwidth(bandwidth);
        remote_off(REMOTE_DLY);
        if radio_type = 535 then toggle_remote;
        show_receiver;
      end;
  end;

  procedure dec_bandwidth;
  begin
    with receiverstat do
      begin
        remote_on;
        bandwidth:=pred(bandwidth);
        set_bandwidth(bandwidth);
        remote_off(REMOTE_DLY);
        if radio_type = 535 then toggle_remote;
        show_receiver;
      end;
  end;

  procedure do_kiwa; { different mode if KIWA MAP unit in use }
  var freq,offset:real;
      x_pos,y_pos:integer;
  begin
    x_pos:=wherex; y_pos:=wherey;
    map:=not map; {toggle mode}
    with receiverstat do
      begin
        if map then {enable mode}
          begin
            if mode = USB then offset:=MAP_OFFSET else offset:=-MAP_OFFSET;
            remote_on;
            set_mode(AM);
            mode:=AM;
            set_bandwidth(WIDE);
            bandwidth:=WIDE;
            set_agc(FAST);
            agc:=FAST;
            frequency:=trunc(frequency / 5.0 + 0.5) * 5.0 + offset;
            set_freq(frequency);
            remote_off(REMOTE_DLY);
          end
        else
          begin
            remote_on;
            freq:=frequency;
            frequency:=trunc(frequency / 5.0 + 0.5) * 5.0;
            set_freq(frequency);
            if frequency < freq then
              begin
                set_mode(USB);
                mode:=USB;
              end
            else
              begin
                set_mode(LSB);
                mode:=LSB;
              end;
            set_bandwidth(INTER);
            bandwidth:=INTER;
          end;
        remote_off(REMOTE_DLY);
      end;
    show_receiver;
    gotoxy(x_pos,y_pos);
  end;

  procedure do_confirm;

  { refresh database time and date and receiver status }

  var recnum:integer;
      tlog,logdata:logtype;
      t_begin, t_end, t_now, dummy:integer;
      ch:char;
      s:string;
  begin
   x_pos:=wherex; y_pos:=wherey;
   { get receiver status }
   if radio_type = 525 then remote_on
   else
     begin
       toggle_remote;
       if async_buffer_check(ch) then check_status(s);
     end;
   show_receiver;
   remote_off(0);
   recnum:=rec - 1;
   if precess(recnum, y_pos) then
     begin
      clear_log(tlog);
      get_log(logbuf,logdata,recdata.recptr[recnum]);
      write_prompt('Confirm:  Type "y" to continue');
      ch:=upcase(fetch);
      cmd_prompt(prompt_num);
      if ch = 'Y' then
        begin
          logdata.date:=tlog.date;
          val(tlog.begin_time,t_now,dummy);
          val(logdata.begin_time,t_begin,dummy);
          val(logdata.end_time,t_end,dummy);
          t_begin:=t_begin - t_now;
          if t_begin < 0 then t_begin:=t_begin + 2400;
          t_end:=t_now - t_end;
          if t_end < 0 then t_end:=t_end + 2400;
          if t_begin < t_end
             then if t_begin < 1200 then logdata.begin_time:=tlog.begin_time;
          if t_end < t_begin
             then if t_end < 1200 then logdata.end_time:=tlog.begin_time;
          with receiverstat do
            begin
              if not map then {don't update receiver params if using map}
                begin
                  logdata.frequency:=frequency;
                  logdata.mode:=mode;
                  logdata.agc:=agc;
                  logdata.attenuator:=attenuator;
                  logdata.bandwidth:=bandwidth;
                end;
            end;
          put_log(logbuf,logdata,recdata.recptr[recnum]);
        end;
      end;
   bottom_window;
   show_log(rec,TRUE,TRUE);
  end;

  procedure do_write; { as in dudley... }
  { copy record at cursor in inactive log to current log }
  var x_pos,y_pos:integer;
      t,recnum:integer;
      ch:char;
      i,j:integer;
      dummy:boolean;
  begin
    if last_log = 0 then exit;
    x_pos:=wherex; y_pos:=wherey;
    recnum:=rec - 1;
    dummy:=precess(recnum,y_pos);
    i:=1;
    while (i < records) and (recdata.recstat[recdata.recptr[i]] <> DELETED)
       do inc(i);
    if (i >= records) and (recdata.recstat[recdata.recptr[i]]<>DELETED) then
      { insert new entry here }
      begin
        inc(records);
        i:=records;
        recdata.recptr[i]:=i;
        loglist.log[loglist.currentlog].records:=records;
        put_loglist(loglist);
      end;
    t:=recdata.recptr[i];
    if recnum = 0 then recnum:=1; { special case for new arrays }
    for j:=i downto recnum + 1 do with recdata do
      recptr[j]:=recptr[j - 1];
    recdata.recptr[recnum]:=t;
    recdata.recstat[t]:=SHOW;
    put_log(logbuf,last_log_data,recdata.recptr[recnum]);
    put_recdata(loglist.currentlog,recdata);
    if display_page <> 1 then
      begin
        display_page:=1;
        draw_display_titles;
        bottom_window;
      end;
    gotoxy(x_pos,y_pos);
    show_log(rec,TRUE,TRUE);
  end;

  procedure do_pageup(cnt:byte);
  var i,j:integer;
  begin
    x_pos:=wherex; y_pos:=LINES - REC_WIN_Y_BOTTOM - 1;
    gotoxy(x_pos,y_pos);
    for j:=1 to cnt do
      begin
        for i:=1 to LINES - REC_WIN_Y_BOTTOM + 1 do
          begin
            if rec > 1 then rec:=rec - 1;
            while (rec > 1) and (recdata.recstat[recdata.recptr[rec]]
                                    <> SHOW) do
              rec:=rec - 1;
          end;
      end;
    if rslt = 0 then show_log(rec,TRUE,TRUE);
  end;

  procedure do_pagedown(cnt:byte);
  var i:integer;
  begin
    x_pos:=wherex; y_pos:=1;
    gotoxy(x_pos,y_pos);
    for i:=1 to cnt do
      if precess(rec, LINES - REC_WIN_Y_BOTTOM - 1) then
          if rec > records then rec:=records;
    if rslt = 0 then show_log(rec,TRUE,TRUE);
  end;

  procedure do_up;
  begin
    x_pos:=wherex; y_pos:=wherey;
    y_pos:=y_pos - 1;
    if y_pos < 1 then
      begin
        y_pos:=1;
        if rec > 1 then rec:=rec - 1;
        while (rec > 1) and (recdata.recstat[rec] <> SHOW) do
          rec:=rec - 1;
        if rslt = 0 then show_log(rec,TRUE,TRUE);
      end
    else
      begin
        show_log(rec,FALSE,FALSE);
        gotoxy(x_pos,y_pos);
        show_log(rec,FALSE,TRUE);
      end;
  end;

  procedure do_down;
  var dummy:boolean;
  begin
    x_pos:=wherex; y_pos:=wherey;
    inc(y_pos);
    if y_pos > LINES - REC_WIN_Y_BOTTOM - 1 then
     begin
       y_pos:=LINES - REC_WIN_Y_BOTTOM - 1;
       dummy:=precess(rec,1);
       if rec > records then rec:=records;
       if rslt = 0 then show_log(rec,TRUE,TRUE);
     end
    else
      begin
        show_log(rec,FALSE,FALSE);
        gotoxy(x_pos,y_pos);
        show_log(rec,FALSE,TRUE);
      end;
  end;

  procedure do_right;
  begin
    x_pos:=wherex; y_pos:=wherey;
    inc(x_pos);
    if x_pos > CHARPERLINE then
      begin
        x_pos:=1;
        inc(display_page);
        if display_page > 3 then display_page:=1;
        draw_display_titles;
        bottom_window;
        if rslt = 0 then show_log(rec,TRUE,TRUE);
      end;
    gotoxy(x_pos,y_pos);
  end;

  procedure do_left;
  begin
    x_pos:=wherex; y_pos:=wherey;
    x_pos:=x_pos - 1;
    if x_pos < 1 then
      begin
        x_pos:=CHARPERLINE;
        display_page:=display_page - 1;
        if display_page < 1 then display_page:=3;
        draw_display_titles;
        bottom_window;
        if rslt = 0 then show_log(rec,TRUE,TRUE);
      end;
    gotoxy(x_pos,y_pos);
  end;

  procedure do_home;
  begin
    rec:=1; x_pos:=1; y_pos:=1;
    gotoxy(x_pos,y_pos);
    show_log(rec,TRUE,TRUE);
  end;

  procedure do_end;
  begin
    rec:=records; x_pos:=1; y_pos:=1;
    do_pagedown(1);
  end;

  procedure new_log(lognum:byte; var rslt:integer);
  begin
    open_log(logbuf,lognum, rslt);
    get_recdata(lognum, recdata);
    records:=loglist.log[lognum].records;
    rec:=loglist.log[lognum].rec;
  end;

  procedure do_alternate;
  var i:integer;
      recnum:integer;
      t_begin, t_end, t_now, dummy:integer;
  begin
    x_pos:=wherex; y_pos:=wherey;
    recnum:=rec - 1;
    sync_loglist;
    if last_log > 0 then
      begin
        new_log(loglist.currentlog,rslt);
        if precess(recnum, y_pos) then
          get_log(logbuf,last_log_data,recdata.recptr[recnum]);
        i:=last_log;
        last_log:=loglist.currentlog;
        loglist.currentlog:=i;
        put_loglist(loglist);
        do_unmark(FALSE);
        close(logbuf);
      end;
    status_window;
    bottom_window;
    get_loglist(loglist);
    new_log(loglist.currentlog,rslt);
    x_pos:=1; y_pos:=1;
    gotoxy(x_pos,y_pos);
    show_log(rec,TRUE,TRUE);
  end;

  procedure do_journal;
  var ch:char;
      new:byte;

    procedure clr_prompt;
    begin
      gotoxy(1,2); clreol;
    end;

    procedure do_select(s:string; var new:byte);
    var found,dummy1,dummy2:boolean;
        i:integer;
        ch:char;
        t,t1:string;
    begin
      repeat
        clr_prompt;
        write(output,'Enter log NAME ',s,' (Enter for none):');
        t:='';
        editfield(47,1,6,FALSE,dummy1,dummy2,t);
        t:=upcasestr(t);

        { search for duplicate }
        found:=FALSE;
        i:=0;
        while (i < MAXLOGS) and not found do
          begin
            inc(i);
            with loglist.log[i] do if t = logname then found:=TRUE;
          end;
        if not found and (t[1] <> ' ') then
          begin
            clr_prompt;
            write(output,'Log not found <SPACE> to continue:');
            ch:=fetch;
            clr_prompt;
          end;
      until found or (t[1] = ' ');
      if not found then i:=loglist.currentlog;
      new:=i;
      clr_prompt;
    end;

    procedure do_create;
    var i:integer;
        s:short_str;
        dummy1,dummy2,found:boolean;
        ch:char;
    begin
      s:='';
      repeat
        clr_prompt;
        write('Enter new log name: ');
        editfield(22,1,6,FALSE,dummy1,dummy2,s);
        s:=upcasestr(s);

        { search for duplicate }
        found:=FALSE;
        for i:=1 to MAXLOGS do
          if s = upcasestr(loglist.log[i].logname) then found:=TRUE;
        if found then
          begin
            clr_prompt;
            write(output,s,': Duplicate log name <SPACE> to continue:');
            ch:=fetch;
            clr_prompt;
          end;
      until not found;

      { add name if not full }
      i:=0;
      while (i < MAXLOGS) and not found do
        begin
          i:=i + 1;
          if loglist.log[i].logname = '' then
            begin
              found:=TRUE;
              with loglist.log[i] do
                begin
                  logname:=s;
                  records:=0;
                  rec:=1;
                end;
              inc(loglist.logcount);
              put_loglist(loglist);
            end;
        end;
        if not found then
          begin
            clr_prompt;
            write(output,'Maximum number of logs exist <SPACE> to cont:');
            ch:=fetch;
            clr_prompt;
          end;
    end;

    procedure do_import;
    const db_name1 = 'SWSKED';

      procedure import(s:string);
      var found:boolean;
          rslt,i,j:integer;
          end_found:boolean;

        procedure move_db(logcnt:integer; var rslt:integer);
        var f:file;
            ch:char;
            i:integer;
            logdat:logtype;

          function read_file(chars:integer):string;
          var buf:array[1..255] of char;
              s:string;
              i:integer;
          begin
            rslt:=ioresult;
            s:='';
            if rslt <> 0 then read_file:=' '
            else
              begin
                blockread(f,buf,chars);
                for i:=1 to chars do s:=s + upcase(buf[i]);
                read_file:=s;
              end;
          end;

          procedure strip_header;
          var buf:array[1..610] of char;
          begin
            { strip off first 610 characters and discard }
            blockread(f,buf,610);
            rslt:=ioresult;
          end;

          procedure get_entry(logcnt:integer);
          var logdat: logtype;
              freqs:array[1..10] of real;
              comments:array[1..10] of string[COMMENTLEN];
              i:integer;

            procedure get_location;
            var s:string;
                i:integer;
                test:boolean;

              function str_compare(s1,s2:string):boolean;
              var i:integer;
                  match:boolean;
              begin
                match:=length(s1) = length(s2);
                if match then for i:=1 to length(s1) do
                  if match then match:= s1[i] = s2[i];
                str_compare:=match;
              end;

            begin
              s:=read_file(20);
              end_found:= pos(chr(26),s) <> 0;
              while length(s) < LOCATIONLEN do s:=s + ' ';
              logdat.location:=s;
            end;

            procedure get_station_id;
            var s:string;
            begin
              s:=read_file(24);
              while length(s) < CALLSIGNLEN do s:=s + ' ';
              logdat.callsign:=s;
            end;

            procedure get_start_time;
            begin
              logdat.begin_time:=read_file(4);
            end;

            procedure get_end_time;
            begin
              logdat.end_time:=read_file(4);
            end;

            function  get_freq:real;
            var freq:real;
                i:integer;
                s:string;
            begin
              freq:=0.0;
              s:=read_file(5);
              for i:=1 to 5 do
                begin
                  if (s[i] in ['0'..'9'])
                     then freq:=freq * 10 + (ord(s[i]) - ord('0'));
                end;
              get_freq:=freq;
            end;

            procedure get_comment;
            var s:string;
                i:integer;
                ch:char;

              procedure parse_comment(var s:string);
              var num1,num2,i,j:integer;
                  ch,separator:char;
                  s1,cmd:string;
                  found:boolean;

                procedure get_num(var s:string; var num:integer);
                var i:integer;
                    found:boolean;
                begin
                  num:=0;
                  found:=FALSE;
                  while not found do
                    begin
                      num:=num * 10 + ord(s[1]) - ord('0');
                      delete(s,1,1);
                      found:=(s = '') or not (s[1] in ['0'..'9']);
                    end;
                end;

                procedure get_next_comment(var str:string);
                var i:integer;
                begin
                  i:=pos('#',s) - 1;
                  if i<=0 then i:=length(s);
                  str:=copy(s,1,i);
                  delete(s,1,i);
                end;

                procedure do_range; { case: #n-m }
                var i:integer;
                    str:string;
                begin
                  get_next_comment(str);
                  for i:=num1 to num2 do comments[i]:=comments[i] + str;
                  { handle case #m-n,o,... }
                  if cmd <> '' then while cmd[1] = ',' do
                    begin
                      delete(cmd,1,1);
                      get_num(cmd,num1);
                      comments[num1]:=comments[num1] + str;
                    end;
                end;

                procedure do_list; { case: #n,o,p...}
                var i:integer;
                    str:string;
                begin
                  get_next_comment(str);
                  comments[num1]:=comments[num1] + str;
                  comments[num2]:=comments[num2] + str;
                  if cmd <> '' then while cmd[1] = ',' do
                    begin
                      delete(cmd,1,1);
                      get_num(cmd,num1);
                      comments[num1]:=comments[num1] + str;
                    end;
                end;

                procedure do_entry; { case: #n }
                var str:string;
                begin
                  get_next_comment(str);
                  comments[num1]:=comments[num1] + str;
                end;

                procedure do_both; { case: #n&m }
                var i:integer;
                    str:string;
                begin
                  get_next_comment(str);
                  comments[num1]:=comments[num1] + str;
                  comments[num2]:=comments[num2] + str;
                  if cmd <> '' then while cmd[1] = '&' do
                    begin
                      delete(cmd,1,1);
                      get_num(cmd,num1);
                      comments[num1]:=comments[num1] + str;
                    end;
                end;

              begin { parse comment }
                { check for comment unique to entries }
                i:=pos('#',s);
                if i = 0 then i:=length(s) + 1;
                { copy message up to command to each comment }
                s1:=copy(s,1,i - 1);
                for j:=1 to 10 do comments[j]:=comments[j] + s1;

                { get comments unique to entry eg #4&5 }
                cmd:='';
                j:=i + 1;
                found:=FALSE;
                while (j < length(s)) and not found do
                  begin
                    found:=s[j] in [' ','#'];
                    if not found then
                      begin
                        cmd:=cmd + s[j];
                        inc(j);
                      end;
                  end;
                delete(s,1,j - 1);

                { decode unique comments and assign }
                {   known formats: #n, #n&m, #n,m,...,#n-m }
                get_num(cmd,num1);
                if cmd <> '' then
                  begin
                    separator:=cmd[1];
                    delete(cmd,1,1);
                    get_num(cmd,num2);
                  end;
                case separator of
                  '-': do_range;
                  '&': do_both;
                  ',': do_list;
                  else do_entry;
                end;
              end;

            begin { get_comment }
              for i:=1 to 10 do comments[i]:='';
              s:='Target:' + read_file(40);
              { parse comments for individual entries }
              while length(s) > 0 do parse_comment(s);
              for i:=1 to 10 do while length(comments[i]) < COMMENTLEN do
                 comments[i]:=comments[i] + ' ';
            end;

            procedure get_date;
            var s:string;
            begin
              s:=read_file(2); { discard decade ie 19 }
              logdat.date:=read_file(6);
            end;

            procedure skip;
            var dummy:string;
            begin
              dummy:=read_file(9);
            end;

          begin { get_entry }
            { set variables that won't change for the duration }
            with logdat do
              begin
                agc:=FAST;
                mode:=USB;
                bandwidth:=INTER;
              end;
            get_location;
            if end_found then exit;
            get_station_id;
            get_start_time;
            get_end_time;
            for i:=1 to 10 do freqs[i]:=get_freq;
            get_comment;
            get_date;
            skip;
            for i:=1 to 10 do
              begin
                if freqs[i] <> 0.0 then
                  begin
                    with loglist.log[logcnt] do
                      begin
                        inc(records);
                        write(output,'.');
                        if records < MAXREC then
                          begin
                            logdat.comment:=comments[i];
                            logdat.frequency:=freqs[i];
                            put_log(logbuf,logdat,records);
                          end;
                      end;
                  end;
              end;
          end;

        begin { move_db }
          assign(f,PATH+S+'.DBF');
          reset(f,1);
          rslt:=ioresult;
          if rslt <> 0 then
            begin
              writeln(output,
                   'Must have ',PATH+S+'.DBF in directory to import');
              hndlerr(TRUE,ch,rslt);
              exit;
            end;
          strip_header;
          home;
          write(output,'Reading / parsing database');
          end_found:=false;
          while (rslt = 0) and not end_found do get_entry(logcnt);
          close(f);
          records:=loglist.log[loglist.currentlog].records;
          for i:=1 to MAXREC do
            begin
              recdata.recptr[i]:=i;
              recdata.recstat[i]:=SHOW;
            end;
          put_recdata(loglist.currentlog,recdata);
          put_loglist(loglist);
          rslt:=0;
        end;

        procedure eliminate_dups(lognum:integer);
        { collapse entries with time overlap }
        var rec1ptr,i,j,t,rslt:integer;
            logdata1,logdata2:logtype;
        begin
          home;
          write(output,'Crunching duplicate entries');
          get_log(logbuf,logdata1,recdata.recptr[1]);
          rec1ptr:=1;
          i:=2;
          while (i < loglist.log[lognum].records) do
            begin
              if recdata.recstat[recdata.recptr[i]] = DELETED then exit;
              get_log(logbuf,logdata2,recdata.recptr[i]);
              write(output,'.');
              if (logdata2.frequency  = logdata1.frequency) and
                 (logdata2.begin_time = logdata1.end_time)  and
                 (logdata2.comment    = logdata1.comment)   and
                 (logdata2.location   = logdata1.location)  and
                 (logdata2.callsign   = logdata1.callsign) then
                begin
                  logdata1.end_time:=logdata2.end_time;
                  put_log(logbuf,logdata1,recdata.recptr[rec1ptr]);
                  t:=recdata.recptr[i];
                  recdata.recstat[t]:=DELETED;
                  for j:=i to records - 1 do with recdata do
                     recptr[j]:=recptr[j + 1];
                  recdata.recptr[records]:=t;
                end
              else { no match }
                begin
                  logdata1:=logdata2;
                  rec1ptr:=i;
                  inc(i);
                end;
            end;
        end;

      begin { import }
        found:=FALSE;
        i:=0;
        while not found and (i < MAXLOGS) do
          begin
            inc(i);
            if s = upcasestr(loglist.log[i].logname) then found:=TRUE;
          end;
        if found then
          begin
            with loglist.log[i] do
               begin
                 logname:=s;
                 records:=0;
                 rec:=1;
               end;
          end
        else { add name if not full }
          begin
            i:=0;
            while (i < MAXLOGS) and not found do
              begin
                i:=i + 1;
                if loglist.log[i].logname = '' then
                  begin
                    found:=TRUE;
                    inc(loglist.logcount);
                    put_loglist(loglist);
                  end;
              end;
            if not found then
              begin
                clr_prompt;
                write(output,'Maximum number of logs exist <SPACE> to cont:');
                ch:=fetch;
                clr_prompt;
                exit;
              end;
            with loglist.log[i] do
               begin
                 logname:=s;
                 records:=0;
                 rec:=1;
               end;
          end;
        loglist.currentlog:=i;
        open_log(logbuf,i,rslt);
        move_db(i,rslt);
        if rslt = 0 then
          begin
            home;
            do_sort(TRUE);
            eliminate_dups(i);
            put_recdata(loglist.currentlog,recdata);
          end;
        close(logbuf);
      end;

    begin
      import(db_name1);
    end;

    procedure do_delete;
    var i:integer;
        s,s1:short_str;
        dummy1,dummy2,found:boolean;
        ch:char;
        f:file;
    begin
      clr_prompt; s:='';
      write('Enter log to DELETE: ');
      editfield(22,1,6,FALSE,dummy1,dummy2,s);
      s:=upcasestr(s);

      { search for entry }
      found:=FALSE;
      i:=0;
      while (i < MAXLOGS) and not found do
        begin
          inc(i);
          if s = upcasestr(loglist.log[i].logname) then found:=TRUE;
        end;
      if found then
        begin
          clr_prompt;
          write(output,'DELETE ',s,'?');
          ch:=upcase(fetch);
          clr_prompt;
          if ch = 'Y' then
            begin
              loglist.log[i].logname:='';
              loglist.log[i].records:=0;
              loglist.log[i].rec:=0;
              loglist.logcount:=loglist.logcount - 1;
              put_loglist(loglist);
              str(i,s1);
              if length(s1) = 1 then s1:='0' + s1;
              s1:=s1 + '.DAT';
              assign(f,PATH + RECDATAFILE + s1);
              erase(f);
              assign(f,PATH + LOGFILE + s1);
              erase(f);
            end;
        end;
    end;

    procedure display_logs;
    var i,j,k,deletions:integer;
        t:string;
        recdata:recdatatype;
    begin
      gotoxy(1,4);
      call_crt(ERASEOS);
      j:=0;
      for i:=1 to MAXLOGS do
        begin
          t:=loglist.log[i].logname;
          if t <> '' then { display it }
            begin
              inc(j);
              deletions:=0;
              get_recdata(i,recdata);
              for k:=1 to loglist.log[i].records do
                if recdata.recstat[k] = DELETED then inc(deletions);
              writeln(output,j:3,'  ',t,' ',loglist.log[i].records
                                  - deletions);
            end;
        end;
    end;

    procedure move_record(marked, move:boolean; dest, from:byte);
    var x_pos,y_pos:integer;
      t,recnum:integer;
      ch:char;
      i,j:integer;
      dummy:boolean;
      logdata:logtype;
      to_recdata,from_recdata:recdatatype;
      found:boolean;
      from_buf,to_buf:file;

      function get_logentry(i:integer;var logdata:logtype):boolean;
      var found:boolean;
          j,k,l:integer;
      begin
        found:=TRUE;
        j:=from_recdata.recptr[i];
        if marked then found:=(i >=min_mark) and (i <=max_mark);
        found:=found and (from_recdata.recstat[j] = SHOW);
        if found then
          begin
            get_log(from_buf,logdata,j);
            if move then { delete old entry }
                from_recdata.recstat[j]:=DELETED;
          end;
        get_logentry:=found;
      end;

      procedure put_logentry(var i:integer; logdata:logtype);
      var j:integer;
      begin
        while (i < loglist.log[dest].records)
          and (to_recdata.recstat[to_recdata.recptr[i]] <> DELETED)
                  do inc(i);
        if (i >= loglist.log[dest].records)
           and (to_recdata.recstat[to_recdata.recptr[i]] <> DELETED) then
        { insert new entry here }
          begin
            inc(loglist.log[dest].records);
            i:=loglist.log[dest].records;
            to_recdata.recptr[i]:=i;
            if recnum = 0 then recnum:=1;
          end;
        t:=to_recdata.recptr[i];
        for j:=i downto recnum + 1 do with to_recdata do
          recptr[j]:=recptr[j - 1];
        to_recdata.recptr[recnum]:=t;
        to_recdata.recstat[t]:=SHOW;
        put_log(to_buf,logdata,to_recdata.recptr[recnum]);
        inc(recnum);
      end;

      procedure push_delete;
      { push deleted records to the end of the chain }
      var i,j,k,last:integer;
      begin
        last:=loglist.log[from].records;
        for i:=1 to last do
          begin
            j:=from_recdata.recptr[i];
            if from_recdata.recstat[j] = DELETED then
              begin
                for k:=i to last - 1 do
                  from_recdata.recptr[k]:=from_recdata.recptr[k + 1];
                from_recdata.recptr[last]:=j;
              end;
          end;
      end;

    begin {move_record }
      recnum:=loglist.log[dest].rec;
      get_recdata(from,from_recdata);
      get_recdata(dest,to_recdata);
      open_log(from_buf,from,rslt); if rslt > 0 then exit;
      open_log(to_buf,dest,rslt);   if rslt > 0 then exit;
      j:=1;
      for i:=1 to loglist.log[from].records do
        begin
          found:=get_logentry(i,logdata);
          if found then put_logentry(j,logdata);
        end;
      if move then push_delete;
      close(to_buf);
      close(from_buf);
      put_recdata(dest,to_recdata);
      put_recdata(from,from_recdata);
      put_loglist(loglist);
    end;

    procedure do_the_write;
    var dest:byte;
    begin
      do_select('to write to',dest);
      move_record(TRUE,FALSE,dest,loglist.currentlog);
    end;

    procedure do_move;
    var dest:byte;
    begin
      do_select('to move to',dest);
      move_record(TRUE,TRUE,dest,loglist.currentlog);
      do_unmark(FALSE);
    end;

    procedure do_print;

    const LINESPERPAGE = 60;

    var pbuf:text;
        i,cnt:integer;
        dummy:boolean;
        logdata:logtype;
        s:short_str;
        s1:string;
        logbuf:file;
        rslt:integer;

      procedure printhdr;
      begin
        write(pbuf,'Num   Date  Strt End  Freq     '+
                          'Station ID          Location');
        writeln(pbuf,'Comment':22,'Md':35,' BW');
        cnt:=1;
      end;

    begin
      assign(pbuf,'LPT1');
      rewrite(pbuf);
      write(pbuf,chr(27),'g'); { compressed mode }
      printhdr;
      i:=0;
      open_log(logbuf,loglist.currentlog,rslt);
      while (i < records) do
        begin
          dummy:=precess(i,1);
          get_log(logbuf,logdata,recdata.recptr[i]);
          if (i >= min_mark) and (i <= max_mark) then
            begin
              inc(cnt);
              if cnt > LINESPERPAGE then
                begin
                  write(pbuf,chr(12)); { form feed }
                  printhdr;
                end;
              with logdata do
                begin
                  write(pbuf,i:4,date:DATELEN + 1,begin_time:TIMELEN + 1);
                  write(pbuf,end_time:TIMELEN + 1);
                  write(pbuf,frequency:9:2,callsign:CALLSIGNLEN + 1);
                  s1:=copy(location,1,22);
                  while length(s1) < 22 do s1:=s1 + ' ';
                  write(pbuf,s1:23);
                  s1:=copy(comment,1,39);
                  while length(s1) < 39 do s1:=s1 + ' ';
                  write(pbuf,s1:40);
                  case mode of
                    RTTY:     s:='RT';
                    CW:       s:='CW';
                    USB:      s:='UB';
                    LSB:      s:='LB';
                    AM:       s:='AM';
                    FM:       s:='FM';
                    FAX:      s:='FX';
                    ECSS_USB: s:='Eu';
                    ECSS_LSB: s:='El';
                  end;
                  write(pbuf,s:3);
                  case bandwidth of
                    NARR:  s:='NR';
                    INTER: s:='IN';
                    WIDE:  s:='WD';
                    AUX:   s:='AX';
                  end;
                  writeln(pbuf,s:3);
                end;
            end;
        end;
      close(pbuf);
      close(logbuf);
    end;

  begin
    sync_loglist;
    close(logbuf);
    repeat
      write_prompt('Journal: '+
      'S(elect, C(reate, D(el, I(mport, W(rite, M(ove, P(rint, Q(uit');
      bottom_window;
      home;
      display_logs;
      ch:=upcase(fetch);
      case ch of
        'S': begin
               do_select('to switch to',new);
               last_log:=new;
               if loglist.currentlog = last_log then last_log:=0;
               put_loglist(loglist);
               cmd_prompt(prompt_num);
               do_alternate;
               exit;
             end;
        'C': do_create;
        'D': do_delete;
        'W': do_the_write;
        'M': do_move;
        'P': do_print;
        'I': do_import;
      end;
    until (ch = 'Q');
    cmd_prompt(prompt_num);
    bottom_window;
    get_loglist(loglist);
    new_log(loglist.currentlog,rslt);
    x_pos:=1; y_pos:=1;
    gotoxy(x_pos,y_pos);
    show_log(rec,TRUE,TRUE);
  end;

  procedure call_do_help;
  begin
    do_help;
    show_log(rec,TRUE,TRUE);
  end;

  procedure check_s_meter(var reading:integer);
  var s:string;
      s_reading, dummy:integer;

  begin
    reading:=1;
    write_com(COM_NRD,'H1'); { lock radio; cmd mode }
    if async_buffer_check(ch) then comreadln(COM_NRD,s); { discard }
    write_com(COM_NRD,'M');  { request s-meter reading }
    write_com(COM_NRD,'H0'); { unlock radio }
    comreadln(COM_NRD,s);
    write_com(COM_NRD,'I1');
    if s[1] = 'M' then { got a valid s-meter reading }
      begin
        delete(s,1,1);
        val(s,s_reading,dummy);
        case s_reading of { map to dB }
          255..245: reading:=-9;
          244..233: reading:=-8;
          232..221: reading:=-7;
          220..209: reading:=-6;
          208..198: reading:=-5;
          197..186: reading:=-4;
          185..174: reading:=-3;
          173..163: reading:=-2;
          162..155: reading:=-1;
          154..163: reading:=1;
          142..155: reading:=2;
          133..143: reading:=3;
          124..134: reading:=4;
          118..125: reading:=5;
          112..119: reading:=6;
          108..113: reading:=7;
          103..109: reading:=8;
           99..104: reading:=9;
           92.. 98: reading:=10;
           90.. 91: reading:=15;
           87.. 89: reading:=20;
           84.. 86: reading:=25;
           81.. 83: reading:=30;
           78.. 80: reading:=35;
           75.. 77: reading:=40;
           73.. 74: reading:=45;
           72.. 72: reading:=50;
           70.. 71: reading:=55;
            0.. 69: reading:=60;
            else reading:=1;
        end;
    end;
  end;

  procedure timed_s_meter;
  var reading:integer;
      hour,minute,sec,sec100:word;
  begin
    x_pos:=wherex; y_pos:=wherey;
    if radio_type <> 535 then exit;
    gettime(hour,minute,sec,sec100);
    time_stamp:=sec;
    if (time_stamp <> old_time_stamp) then
      begin
        old_time_stamp:=time_stamp;
        check_s_meter(reading);
        top_window;
        gotoxy(42,3);
        writea(LIGHTGRAY,FOREGROUND);
        write(output,'S-Meter:');
        if (reading > 9)
          then writea(RED,FOREGROUND)
          else writea(CYAN,FOREGROUND);
        write(output,reading:2);
        bottom_window;
      end;
  end;

  procedure init_crt;
  begin
    home;
    init_rec_window;
    update_receiver_display:=TRUE;
    status_window;
    bottom_window;
  end;

  procedure graph_init;
  var graphdriver:integer;
      errorcode:integer;
  begin
    if radio_type = 525 then exit;
    graphdriver:=detect;
    case graphdriver of
      CGA:     graphmode:=CGAHI;
      MCGA:    graphmode:=MCGAHI;
      EGA:     graphmode:=EGAHI;
      EGA64:   graphmode:=EGA64HI;
      EGAMONO: graphmode:=EGAMONOHI;
      IBM8514: graphmode:=IBM8514HI;
      HERCMONO:graphmode:=HERCMONOHI;
      ATT400:  graphmode:=ATT400HI;
      VGA:     graphmode:=VGAHI;
      PC3270:  graphmode:=PC3270HI;
    end;
    initgraph(graphdriver,graphmode,'');
    errorcode:=graphresult;
    if errorcode <> grok then exit;
    restorecrtmode;
    home;
  end;

  procedure do_graph;
  const X_INIT    = 40;
        Y_INIT    = 100;
        SCALE     = 2.2;
        Y_SCALE   = 480;
        X_SCALE   = 640;
        X_AXIS    = X_INIT - 5;

  type plottype = (NONE, TIME, SPECTRAL);

  var count:integer;
      reading:integer;
      dummy:integer;
      max_x,max_y:integer;
      max_count:integer;
      hour,minute,sec,sec100:word;
      last_plot:plottype;
      ch:char;
      start_freq, stop_freq:real;

    function scale_y(reading:integer):integer;
    begin
      scale_y:=round((reading * SCALE - Y_INIT) * max_y / Y_SCALE);
    end;

    procedure init_graph;
    var y:integer;

      procedure draw_tick(reading:integer; db:string);
      var y:integer;
      begin
        y:=scale_y(reading);
        moveto(X_AXIS-2,y);
        lineto(X_AXIS+5,y);
        setcolor(8);
        lineto(max_x,y);
        setcolor(15);
        moveto(X_AXIS-30,y-3);
        outtext(db);
      end;

    begin
      setgraphmode(graphmode);
      moveto(X_AXIS,scale_y(240));
      lineto(X_AXIS,scale_y(60));
      draw_tick(67,'');
      draw_tick(71,'+50');
      draw_tick(75,'');
      draw_tick(81,'+30');
      draw_tick(87,'');
      draw_tick(92,'+10');
      draw_tick(99,'+9');
      draw_tick(108,'+7');
      draw_tick(118,'+5');
      draw_tick(133,'+3');
      draw_tick(154,'+1');
    end;

    function get_s_reading:integer;
    var s,s1:string;
        ch:char;
        reading:integer;
        freq:real;
    begin
      repeat
        write_com(COM_NRD,'M');  { request s-meter reading }
        comreadln(COM_NRD,s);
        ch:=s[1];
        delete(s,1,1);
        if ch = 'M' then val(s,reading,dummy);
      until ch = 'M';
      get_s_reading:=reading;
    end;

    procedure plot_title(s:string);
    begin
      setfillstyle(1,0);
      bar(100,18,max_x,25);
      moveto(((max_x - length(s)) div 2) - 25,18);
      outtext(S);
    end;

    procedure clear_prompt;
    begin
      setfillstyle(1,0);
      bar(1,1,max_x,8);
      setcolor(2);
      moveto(1,1);
    end;

    procedure out_prompt(s:string);
    begin
      clear_prompt;
      outtext(s);
      setcolor(15);
    end;

    procedure main_prompt;
    begin
      out_prompt('GRAPHICS: C(lear, T(ime plot, S(pectral plot, Q(uit');
    end;

    procedure time_plot;
    var ch:char;
    begin
      out_prompt('Hit <SPACE BAR> to stop');
      setfillstyle(1,0);
      bar(1,scale_y(238),getmaxx,scale_y(260));
      plot_title('T I M E  P L O T');
      count:=0;
      write_com(COM_NRD,'H1'); { lock radio; cmd mode }
      reading:=get_s_reading;
      moveto(X_INIT,scale_y(reading));
      setcolor(11);
      while not keypressed do
        begin
          gettime(hour,minute,sec,sec100);
          time_stamp:=sec;
          if (time_stamp <> old_time_stamp) then
            begin
              old_time_stamp:=time_stamp;
              inc(count);
            end;
          reading:=get_s_reading;
          lineto(X_INIT + count, scale_y(reading));
          if count > max_count then
            begin
              count:=0;
              moveto(X_INIT,scale_y(reading));
            end;
        end;
      main_prompt;
      ch:=fetch; { get key pressed and discard }
    end;

    procedure spectral_plot;
    const BUFFERSIZE = 100;
          PLOTBUFSIZE = 1024;
    var ok,nullval:boolean;
        start,stop:integer;
        delta:real;
        last_freq, freq:real;
        freq_range:real;
        count_delta,count:integer;
        i:integer;
        s:string;
        freq_buffer: array[1..BUFFERSIZE] of byte;
        plot_buffer, plot_cnt: array[0..PLOTBUFSIZE] of byte;
        old_stat:receivertype;
        ch:char;

      procedure draw_x_axis;
      const POINTS = 8;
      var i,x:integer;
          del:real;
          s:string;
          f:real;
      begin
        moveto(X_AXIS,scale_y(240));
        lineto(max_x, scale_y(240));
        del:=max_count / POINTS;
        for i:=0 to POINTS do
          begin
            x:=round(X_AXIS + del * i);
            moveto(x, scale_y(242));
            lineto(x, scale_y(238));
            moveto(x - 26, scale_y(250));
            f:=start_freq + i * ((stop_freq - start_freq) / POINTS);
            str(f:7:1,s);
            outtext(s);
          end;
      end;

      procedure radio_setup;
      var s:string;
      begin
        old_stat:=receiverstat;
        write_com(COM_NRD,'H1'); { lock radio; cmd mode }
        set_mode(CW);
        set_bandwidth(INTER);
        write_com(COM_NRD,'W0500'); { set bw to 500hz }
        if freq_range <= 100.0 then s:='1' else s:='2';
        write_com(COM_NRD,'V' + s); { control tuning increment }
        set_agc(FAST);
        set_freq(start_freq);
        delay(200);
        write_com(COM_NRD,'H0');
      end;

      procedure get_scan_range;
      begin
        start:=round(start_freq);
        str(start_freq:5:0,s);
        s:='starting frequency [default=' + s + ']';
        entnum(1,5,start,ok,nullval,s);
        if not ok then exit;
        if not nullval then start_freq:=start;
        stop:=round(stop_freq);
        str(stop_freq:5:0,s);
        s:='stopping frequency [default=' + s + ']';
        entnum(1,7,stop,ok,nullval,s);
        if not ok then exit;
        if not nullval then stop_freq:=stop;
      end;

      procedure restore_radio; { to settings prior to spectral plot }
      begin
        remote_on;
        write_com(COM_NRD,'W2400'); { set bw to 2400hz }
        with receiverstat do
          set_all(199,attenuator,bandwidth,mode,frequency,agc);
        write_com(COM_NRD,'V0');
        write_com(COM_NRD,'H0'); { unlock radio }
        delay(REMOTE_DLY);
      end;

      procedure plot_point(freq:real;y:byte);
      var x,ave:integer;
          color:integer;
      begin
        { adaptively Kalman filter reading to get statistical average }
        {   the idea is to end up with a running average where the last }
        {   point has no more influence than the first  }
        x:=round(max_count * ((freq - start_freq) / freq_range));
        ave:=round((plot_cnt[x] * plot_buffer[x] + y) / (plot_cnt[x] + 1));
        plot_buffer[x]:=ave;
        if plot_cnt[x] < 255 then inc(plot_cnt[x]);

        { now draw point }
        if y < 99 then color:=12 else color:=11;
        putpixel(x + X_AXIS,scale_y(y),color);
      end;

      procedure draw_average;
      var x:integer;
      begin
        moveto(X_AXIS,scale_y(plot_buffer[0]));
        setcolor(14);
        for x:=1 to max_count do if plot_buffer[x] > 0 then
          lineto(x + X_AXIS,scale_y(plot_buffer[x]));
      end;

      procedure init_spectral_plot;
      begin
        init_graph;
        out_prompt('COMMANDS: A(verage, C(lear, Q(uit');
        plot_title('S P E C T R A L  P L O T');
        draw_x_axis;
      end;

    begin
      restorecrtmode;
      home;
      writea(LIGHTGREEN,FOREGROUND);
      writeln(output, ' SPECTRAL PLOT: Enter the frequency range to scan');
      get_scan_range;
      init_spectral_plot;
      freq_range:=stop_freq - start_freq;
      radio_setup;

      { init plot statistics used to Kalman filter averages }
      for i:=0 to max_count do
        begin
          plot_buffer[i]:=0;
          plot_cnt[i]:=0;
        end;

      last_freq:=start_freq;
      ch:=' ';
      repeat
        remote_on;
        delay(200);
        count:=0;
        write_com(COM_NRD,'Y+');

        { gather data }
        while not keypressed and (count < BUFFERSIZE) do
          begin
            inc(count);
            freq_buffer[count]:=get_s_reading;
          end;
        write_com(COM_NRD,'H0'); { remote_off }
        toggle_remote;
        delay(300);
        if async_buffer_check(ch) then check_status(s); { get frequency }
        freq:=receiverstat.frequency;
        if freq > stop_freq then
          begin
            remote_on;
            set_freq(start_freq);
            delay(200);
          end;
        write_com(COM_NRD,'H0');
        delta:=(freq - last_freq) / BUFFERSIZE;

        { plot buffer contents }
        count:=0;
        freq:=last_freq;
        while (freq < stop_freq) and (count < BUFFERSIZE) do
          begin
            inc(count);
            plot_point(freq, freq_buffer[count]);
            freq:=freq + delta;
          end;
        last_freq:=receiverstat.frequency;
        if last_freq > stop_freq then last_freq:=start_freq;
        if keypressed then
          begin
             ch:=upcase(fetch);
             case ch of
               'A': draw_average;
               'C': init_spectral_plot;
             end;
          end;
      until ch = 'Q';
      receiverstat:=old_stat;
      restore_radio;
      main_prompt;
    end;

  begin
    start_freq:=receiverstat.frequency - 5.0;
    stop_freq :=receiverstat.frequency + 5.0;
    if radio_type <> 535 then exit;
    max_x:=getmaxx - 30; max_y:=getmaxy;
    max_count:=max_x - X_AXIS;
    last_plot:=NONE;
    init_graph;
    main_prompt;
    repeat
      if keypressed then ch:=upcase(fetch) else ch:='@' { nop };
      case ch of
        '@':; { nop }
        'C':begin
              init_graph;
              main_prompt;
            end;
        'T':time_plot;
        'S':spectral_plot;
      end;
    until ch = 'Q';
    restorecrtmode;
    init_crt;
    write_com(COM_NRD,'H0'); { unlock radio }
    comreadln(COM_NRD,s);
    write_com(COM_NRD,'I1');
    gotoxy(x_pos,y_pos);
    show_log(rec,TRUE,TRUE);
  end;

begin { nrd }
  graph_init;
  old_time_stamp:=0;
  last_log:=0;
  enable_s_meter:=FALSE;
  init_com;
  if has_map then
    begin
      remote_on;  { get receiver status to see if map is on }
      remote_off(0);
      map:=receiverstat.mode = AM;  { assume MAP in use if radio in AM }
    end
  else map:=FALSE;
  prompt_num:=PAGE1;
  get_loglist(loglist);
  new_log(loglist.currentlog,rslt);
  init_crt;
  x_pos:=1; y_pos:=1;
  do_unmark(TRUE);

  { init old receiver status to current radio settings }
  oldstat:=receiverstat;
  if radio_type = 535 then
    begin
      toggle_remote; { get radio status; dial changes will be cont sent }
      show_receiver;
    end;
  repeat
    if (radio_type = 535) and async_buffer_check(ch) then
      begin
        check_status(s); { they changed dial }
        show_receiver;
      end;
    if enable_s_meter then timed_s_meter;
    if update_receiver_display then
      begin
        if radio_type = 525 then
          begin
            remote_on;
            show_receiver;
            remote_off(REMOTE_DLY);
          end
        else
          begin
            toggle_remote;
            show_receiver;
          end;
        update_receiver_display:=FALSE;
      end;
    if keypressed then ch:=upcase(fetch) else ch:='@' { nop };
    case ch of
      '@':; { nop }
      '+':              inc_freq;
      '-':              dec_freq;
      '*':              find_freq;
      '/':              begin
                          if prompt_num = PAGE1 then prompt_num:=PAGE2
                                                else prompt_num:=PAGE1;
                          cmd_prompt(prompt_num);
                          bottom_window;
                        end;
      'A':              begin
                          close(logbuf);
                          do_alternate;
                        end;
      'C':              do_confirm;
      'P':              do_page;
      'S':              do_sort(FALSE);
      'E':              do_edit;
      'G':              do_graph;
      'J':              do_journal;
      'D':              do_delete;
      'N':              do_undelete;
      'M':              do_mark;
      'U':              do_unmark(TRUE);
      'L':              do_log;
      'R':              begin
                          enable_s_meter:=not enable_s_meter;
                          if not enable_s_meter then
                            begin
                              top_window;
                              gotoxy(42,3);
                              write(output,'          ');
                              bottom_window;
                            end;
                        end;
      'T':              do_tune;
      'K':              if has_map then do_kiwa;
      'W':              do_write;
      '>':              inc_mode;
      '.':              inc_mode;
      '<':              dec_mode;
      ',':              dec_mode;
      ']':              inc_bandwidth;
      '[':              dec_bandwidth;
      'H':              begin
                          call_do_help;
                          status_window;
                        end;
      PAGEUP:           do_pageup(1);
      PAGEDOWN:         do_pagedown(1);
      UP:               do_up;
      DOWN:             do_down;
      RIGHTARROW:       do_right;
      LEFTARROW:        do_left;
      BACKTAB:          do_backtab;
      TAB:              do_tab;
      CTRLPAGEUP:       do_pageup(10);
      CTRLPAGEDN:       do_pagedown(10);
      HOMEKY:           do_home;
      ENDKY:            do_end;
      else update_receiver_display:=TRUE;
    end;
  until ch = 'Q';
  if radio_type = 535 then write_com(COM_NRD,'I0'); { unlock radio }
  sync_loglist;
  close(logbuf);
  window(1,1,80,25);
  home;
  gotoxy(1,8);
  writeln(output,'Send comments and suggestions to:');
  writeln(output);
  writeln(output,'    Tom Whiteside [phone]');
  writeln(output,'    11505 Oak View');
  writeln(output,'    Austin, TX 78759');
end.  { nrd }